home *** CD-ROM | disk | FTP | other *** search
/ JCSM Shareware Collection 1993 November / JCSM Shareware Collection - 1993-11.iso / cl760 / scnp785j.lzh / FUNGEN.BAS < prev    next >
BASIC Source File  |  1991-08-19  |  5KB  |  107 lines
  1. 10 REM  PROGRAM FUNGEN GENERATES VALUES OF A FUNCTION.
  2. 20 REM  THE PROGRAM WRITES THE VALUES ALONG WITH PLOT COMMANDS TO A FILE
  3. 30 REM  NAMED FUNDATA.PLT; THE VALUES ARE THEN PLOTTED BY USING THE SHELL
  4. 40 REM  COMMAND TO RUN THE SPLOT PROGRAM.
  5. 50 REM
  6. 80 REM  WARNING: DO NOT RENUMBER!
  7. 90 REM
  8. 100 CLS: KEY OFF
  9. 110 PRINT"This program plots up to 5 functions defined by subroutines"
  10. 120 PRINT"which follow the main program.  Each subroutine must set the"
  11. 130 PRINT"dependent variable Y equal to a function evaluated at the"
  12. 140 PRINT"current value of the independent variable X or, optionally,"
  13. 142 PRINT"set variables X and Y equal to a pair of parametrical functions
  14. 143 PRINT"evaluated at the current value of the parameter T.
  15. 150 PRINT
  16. 160 PRINT"List lines 1000-1999 to see current functions."
  17. 180 REM
  18. 182 PRINT:INPUT"Are the functions represented parametrically (N/Y)"; P.$
  19. 183 P.$=LEFT$(P.$,1): IF P.$ = "y" THEN P.$ = "Y"
  20. 190 OPEN "FUNDATA.PLT" FOR OUTPUT AS #2
  21. 200 PRINT: LINE INPUT"Title? "; TITLE$: PRINT#2,"TITLE "+TITLE$
  22. 210 PRINT: LINE INPUT"X-Axis Label? ";LX$: PRINT#2,"XLABEL "+LX$
  23. 220 LINE INPUT"Y-Axis Label? ";LY$: PRINT#2,"YLABEL "+LY$
  24. 230 PRINT: INPUT"Log X-Axis (N/Y)"; A$: A$=LEFT$(A$,1)
  25. 240 IF A$="Y" OR A$="y" THEN PRINT#2,"LOGX"
  26. 250 INPUT"Log Y-Axis (N/Y)"; A$: A$=LEFT$(A$,1)
  27. 260 IF A$="Y" OR A$="y" THEN PRINT#2,"LOGY"
  28. 270 PRINT: INPUT"Draw grid lines (N/Y)";A$: A$=LEFT$(A$,1)
  29. 280 IF A$="Y" OR A$="y" THEN PRINT#2,"GRID"
  30. 290 REM
  31. 300 NP.=1: PRINT: INPUT"Number of functions (1-5)"; NP.
  32. 310 IF NP. > 5 THEN PRINT"TOO MANY": END
  33. 320 IF NP. < 1 THEN NP. = 1
  34. 330 FOR J.=1 TO NP.
  35. 340  IF NP. > 0 THEN PRINT:PRINT"Function #";J.;":"
  36. 350  PRINT
  37. 360  PRINT"Enter initial value, final value & step size of ";
  38. 370  IF P.$ <> "Y" THEN PRINT"independent variable" ELSE PRINT"parameter"
  39. 372  PRINT"separated by spaces";
  40. 380  IF J. > 1 THEN PRINT" (press ENTER key if same)";
  41. 390  INPUT V$: IF V$="" GOTO 470
  42. 400   GOTO 420
  43. 410    INPUT"Initial Value, Final Value, Step Size"; V$: IF V$="" GOTO 470
  44. 420   P=1: GOSUB 680: XI. = V: GOSUB 680: XF. = V: GOSUB 680: XS. = V
  45. 430   IF XS. <= 0 THEN PRINT"ERROR: INVALID STEP SIZE": GOTO 410
  46. 440   ND. = INT( (XF.-XI.)/XS. + 1.5 )
  47. 450   IF ND. < 2 THEN PRINT"ERROR: INVALID RANGE": GOTO 410
  48. 460   IF ND. > 1024 THEN PRINT"ERROR: TOO MANY POINTS - MAX IS 1024": GOTO 410
  49. 470  PRINT:PRINT"Calculating..."
  50. 472  IF ND. <= 61 AND P.$ <> "Y" THEN PRINT#2,"CURVE ";J.
  51. 474  IF ND. <= 21 THEN PRINT#2,"SYMBOLS ";J.
  52. 480  PRINT#2,"READ ";ND.
  53. 490  FOR I.=1 TO ND.
  54. 500   IF P.$ <> "Y" THEN X = XI. + (I.-1)*XS. ELSE T = XI. + (I.-1)*XS.
  55. 510   ON J. GOSUB 1100, 1200, 1300, 1400, 1500
  56. 520   PRINT#2, X;" ";Y
  57. 530  NEXT I.
  58. 540 NEXT J.
  59. 545 PRINT#2,"PLOT": PRINT#2,"KEYBOARD"
  60. 550 CLOSE#2
  61. 560 REM
  62. 570 PRINT:PRINT"Press the ENTER key to display the plot";
  63. 580 PRINT" - press the ESC key to clear the plot."
  64. 590 A$=INKEY$: IF A$<>"" GOTO 590
  65. 600 A$=INKEY$: IF A$="" GOTO 600
  66. 610 IF ASC(A$)<>13 GOTO 600
  67. 620 SHELL( "SPLOT FUNDATA.PLT" )
  68. 630 END
  69. 670 REM EXTRACTS V FROM V$ STARTING AT POSITION P
  70. 680 P2=LEN(V$)
  71. 690 IF MID$(V$,P,1)=" " AND P<=P2 THEN P=P+1: GOTO 690
  72. 700 P0=P: IF P0>P2 THEN V=0: RETURN
  73. 710 IF MID$(V$,P,1)<>" " AND P<=P2 THEN P=P+1: GOTO 710
  74. 720 V = VAL( MID$( V$, P0, P-P0 ) )
  75. 730 RETURN
  76. 1000 REM
  77. 1010 REM NOTE: To avoid conflict with main program variables,
  78. 1020 REM       do not use variable names that contain a period.
  79. 1030 REM
  80. 1100 REM Subroutine #1 must set variable Y = FUNCTION(X) after this line #
  81. 1110 Y = COS(X)*EXP(-ABS(X/5))
  82. 1190 RETURN
  83. 1200 REM Subroutine #2 must set variable Y = FUNCTION(X) after this line #
  84. 1210 Y = SIN(X)*EXP(-ABS(X/5))
  85. 1290 RETURN
  86. 1300 REM Subroutine #3 must set variable Y = FUNCTION(X) after this line #
  87. 1310 N=0: GOSUB 2000: Y=J#: REM Y = J0(X) calculated by called subroutine
  88. 1390 RETURN
  89. 1400 REM Subroutine #4 must set variable Y = FUNCTION(X) after this line #
  90. 1410 N=1: GOSUB 2000: Y=J#: REM Y = J1(X) calculated by called subroutine
  91. 1490 RETURN
  92. 1500 REM Subroutine #5 must set variable Y = FUNCTION(X) after this line #
  93. 1510 N=2: GOSUB 2000: Y=J#: REM Y = J2(X) calculated by called subroutine
  94. 1999 RETURN
  95. 2000 REM SETS J# = BESSEL FUNCTION OF THE FIRST KIND OF ORDER N: Jn(X)
  96. 2010 IF INT(N)<>N THEN PRINT"Jn(X) MUST BE OF INTEGER ORDER.": END
  97. 2020 C# = (X/2#)^N
  98. 2030 IF N>1 THEN FOR K=2 TO N: C# = C#/K: NEXT K
  99. 2040 J# = C#: IF ABS(X)<.001 THEN RETURN
  100. 2050 Z# = -X*X/4#: K=0
  101. 2060  K = K+1: C# = Z#/K/(K+N)*C#: J# = J# + C#
  102. 2070  IF ABS(C#)>1E+08 OR K>100 GOTO 2100
  103. 2080 IF ABS(C#)>.00005 GOTO 2060
  104. 2090 RETURN
  105. 2100 PRINT"CAN NOT ACCURATELY CALCULATE Jn(X) FOR n =";N;" & |X| >";ABS(X)
  106. 2110 END
  107.